home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr53 / atext.zip / ATEXT.LSP
Lisp/Scheme  |  1993-06-08  |  4KB  |  86 lines
  1. ;atext.lsp
  2. ;
  3. ;     Copyright (C) 1988-1992 by Autodesk, Inc.
  4. ;
  5. ;     Permission to use, copy, modify, and distribute this software 
  6. ;     for any purpose and without fee is hereby granted, provided 
  7. ;     that the above copyright notice appears in all copies and that 
  8. ;     both that copyright notice and this permission notice appear in 
  9. ;     all supporting documentation.
  10. ;
  11. ;     THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  12. ;     WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  13. ;     PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  14. ;     ****************************************************************
  15. ;  Larry Knott  
  16. ;
  17. ;  Draws center aligned text along an ARC.  The start point of the text
  18. ;  is the ENDpoint of the ARC closest the pick point.
  19. ;
  20.  
  21. (defun rtd (a) (* a (/ 180 pi)))         ;  radians to degrees
  22.  
  23. (defun getarc (/ no_arc e0 e1)
  24. (setq no_arc T)
  25. (while no_arc
  26.   (if (setq e0 (entsel "\nSelect arc: "))  
  27.     (if (= (cdr (assoc 0 (setq e1 (entget (car e0))))) "ARC")
  28.       (setq no_arc nil)
  29.       (princ (strcat (cdr (assoc 0 e1)) ", Not an arc."))
  30.     )                                    ;  end IF
  31.     (princ " No object found.")
  32.   )                                      ;  end IF
  33. )                                        ;  end WHILE
  34. (setq c1 (cdr (assoc 10 e1))             ;  center point
  35.       r1 (cdr (assoc 40 e1))             ;  radius
  36.       a0 (cdr (assoc 50 e1))             ;  start arc angle
  37.       a1 (cdr (assoc 51 e1))             ;  end arc angle
  38.       i1 (if (> a1 a0)                   ;  included angle
  39.            (- a1 a0)
  40.            (+ a1 (- (* pi 2) a0))
  41.          )                               ;  end IF
  42.       p1 (osnap (cadr e0) "end")         ;  start point pick
  43.       p2 (polar c1 a1 r1)                ;  end point arc
  44. )                                        ;  end SETQ
  45. )                                        ;  end DEFUN
  46.  
  47. (defun getset (/ h1 t1 n1 a2)
  48. (setq h1                                 ;  check current text style height
  49.   (if (zerop (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
  50.          (getdist p1 "\nHeight: ")       ;  text height
  51.          nil                             ;  height defined by STYLE
  52.   )                                      ;  end IF
  53.       t1 (getstring T "\nText: ")        ;  text string
  54.       n1 1                               ;  counter
  55.       a2 (/ i1 (1- (strlen t1)))         ;  angle increment
  56. )                                        ;  end SETQ
  57. (if (< (distance p1 p2) 1.0E-8)          ;  clockwise?
  58.   (setq o1 '-)                           ;  clockwise
  59.   (setq o1 '+                            ;  counter-clockwise
  60.         a1 a0
  61.   )                                      ;  end SETQ
  62. )                                        ;  end IF
  63. (setvar "cmdecho" 0)                     ;  suppress command echo
  64. (setvar "highlight" 0)                   ;  suppress hightlighting
  65. (setvar "blipmode" 0)                    ;  suppress blips
  66. (repeat (strlen t1)                      ;  for each character
  67.   (command "text" "c" p1)                ;  TEXT command
  68.   (if h1 (command h1))
  69.   (command ((eval o1) (rtd a1) 90) (substr t1 n1 1))
  70.   (setq a1 ((eval o1) a1 a2)             ;  increment angle 
  71.         n1 (1+ n1)                       ;  increment counter
  72.         p1 (polar c1 a1 r1)              ;  increment text point
  73.   )                                      ;  end SETQ
  74. )                                        ;  end REPEAT
  75. (setvar "cmdecho" 1)                     ;  enable command echo
  76. (setvar "highlight" 1)                   ;  enable hightlighting
  77. (setvar "blipmode" 1)                    ;  enable blips
  78. )                                        ;  end DEFUN
  79.  
  80. (defun c:atext()
  81. (princ "\n  *** Draws text on arcs ***") ;  banner
  82. (getarc)                                 ;  get the arc
  83. (getset)                                 ;  get the settings and draw text
  84. (prin1)                                  ;  quiet exit
  85. )                                        ;  end DEFUN
  86.